Лабораторна робота № 3
Тема: Транспортні сітки.
Мета: ознайомитись з алгоритмом Форда-Фалкенсона для знаходження потоку найбільшої довжини.
Код програми:
program MAX_POTIK;
uses crt;
type
adresa=^lanka;
lanka=record
p:byte;
d:byte;
zdat:byte;
potik:byte;
next:adresa;
end;
adresal=^elem;
elem=record
l:adresa;
next:adresal;
end;
{*****************}
function MINIM(a,b:byte):byte;
begin
if (a>b) then
MINIM:=b
else
MINIM:=a;
end;{MINIM}
{*****************}
procedure DODATY_V_SPYSOK(var adr1:adresa;l:lanka);
var adr:adresa;
begin
if (adr1=nil) then
begin
adr1:=new(adresa);
adr1^:=l;
adr1^.next:=nil;
exit;
end;
adr:=adr1;
while (adr^.next<>nil) do
adr:=adr^.next;
adr^.next:=new(adresa);
adr^.next^:=l;
adr^.next^.next:=nil;
end;{DODATY_V_SPYSOK}
{*****************}
procedure DOD_L(var adr1:adresal;punkt:adresa);
var adr:adresal;
begin
adr:=new(adresal);
adr^.l:=punkt;
adr^.next:=adr1;
adr1:=adr;
end;{DOD_L}
{*****************}
procedure VYKYN_L(var adr1:adresal);
var adr:adresal;
begin
if (adr1<>nil) then
begin
adr:=adr1^.next;
dispose(adr1);
adr1:=adr;
end;
end;{VYKYN_L}
{*****************}
procedure STVOR_SPYSOK(var adr1:adresa;var maxn,maxzdat:byte);
var f:text;
l:lanka;
s:string;
begin
l.potik:=0;
maxn:=0;
maxzdat:=0;
clrscr;
writeln('Vvedit'' imya fayla z informaciyeyu ( pravyl''noyu !!! ) :');
readln(s);
s:='D:\misha\'+s+'.txt';
assign(f,s);
reset(f);
while (not(eof(f))) do
begin
readln(f,l.p,l.d,l.zdat);
if (maxn<l.d) then
maxn:=l.d;
if (maxzdat<l.zdat) then
maxzdat:=l.zdat;
DODATY_V_SPYSOK(adr1,l);
end;
close(f);
end;{STVOR_SPYSOK}
{*****************}
function IS_IN_PROYDENI(proydeni:adresal;n:byte):boolean;
var adrl:adresal;
bool:boolean;
begin
bool:=false;
adrl:=proydeni;
while ((adrl<>nil) and (not bool)) do
begin
bool:=((n=adrl^.l^.p) or (n=adrl^.l^.d));
adrl:=adrl^.next;
end;
IS_IN_PROYDENI:=bool;
end;{IS_IN_PROYDENI}
{*****************}
procedure SHLYAH(holova:adresa;
poch,kin:byte;
var min:byte;
var proydeni:adresal;
var bool:boolean);
var adr:adresa;
min1:byte; {min povynno zminyuvatysya lyshe v razi
uspishnoho prohodgennya}
begin
if (poch=kin) then
bool:=true
else
begin
bool:=false;
adr:=holova;
while ((adr<>nil) and (not(bool))) do
begin
{1}
if ((adr^.p=poch)
and (adr^.zdat>adr^.potik)
and not (IS_IN_PROYDENI(proydeni,adr^.d))) then
begin
min1:=MINIM(min,adr^.zdat-adr^.potik);
DOD_L(proydeni,adr);
SHLYAH(holova,adr^.d,kin,min1,proydeni,bool);
if (bool) then
begin
min:=min1;
adr^.potik:=adr^.potik+min;
end;
VYKYN_L(proydeni);
end;
{2}
if ((adr^.d=poch)
and (adr^.potik>0)
and not (IS_IN_PROYDENI(proydeni,adr^.p))) then
begin
min1:=MINIM(min,adr^.potik);
DOD_L(proydeni,adr);
SHLYAH(holova,adr^.p,kin,min1,proydeni,bool);
if (bool) then
begin
min:=min1;
adr^.potik:=adr^.potik-min;
end;
VYKYN_L(proydeni);
end;
adr:=adr^.next;
end;
end;
end;{SHLYAH}
{*****************}
VAR
adr1,adr:adresa;
maxn,maxz,rezerv:byte;
proydeni:adresal;
p:integer;
bool:boolean;
BEGIN {HOLOVNA PROHRAMA}
p:=0;
bool:=true;
proydeni:=nil;
STVOR_SPYSOK(adr1,maxn,maxz);
rezerv:=0;
adr:=adr1;
writeln('******************');
writeln(' Informaciya:');
while (adr<>nil) do
begin
writeln(' ',adr^.p,' ',adr^.d,' ',adr^.zdat);
adr:=adr^.next;
end;
writeln;
writeln('varshyna-kinec? ',m...
